home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 38 / Amiga Format CD38 (1999-03-15)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-04].iso / -seriously_amiga- / graphics / animfx / src / animfx.1.57.p next >
Text File  |  1999-02-02  |  47KB  |  1,389 lines
  1. Program IFF;
  2.  
  3. {Anzeigezeit des Screenmoderequesters abziehen!}
  4. {in UNDOLASTFRAME checken, ob LoadSEntry gleiche Position wie LoadDEntry hat}
  5.  
  6. {$incl"libraries/dos.h","intuition.lib","graphics.lib","exec/memory.h",
  7.       "aga.lib","soundplay.mod","reqtools.h"}
  8.  
  9. type TagArr=array [1..10] of long;
  10. type LArr16=array [1..16] of long;
  11.  
  12.  
  13. type p_PicListEntry=^PicListEntry;
  14. type PicListEntry=record
  15.         NextPicEntry            :p_PicListEntry;
  16.         Flags                   :byte;
  17.         FrameNum,MSecs          :long;
  18.         PMemA,PMemL,CMemA,CMemL :long;
  19.      end;
  20.  
  21. type p_SndListEntry=^SndListEntry;
  22. type SndListEntry=record
  23.         NextSndEntry    :p_SndListEntry;
  24.         FrameNum        :long;
  25.         SMemA,SMemL     :long;
  26.      end;
  27.  
  28. var DataAddr                                    :^LArr16;
  29. var IBase                                       :^IntuitionBase;
  30. var f                                           :text;
  31. var MyFReq                                      :^rtFileRequester;
  32. var FirstSEntry                                 :SndListEntry;
  33. var FirstDEntry                                 :PicListEntry;
  34. var LoadSEntry,MySEntry,LastSEntry              :^SndListEntry;
  35. var LoadDEntry,MyDEntry,LastDEntry              :^PicListEntry;
  36.  
  37. var ChunkName                                   :string[5];
  38. var ChunkLength,Frames,l,SpaceMem,CMAPPos,
  39.     ChunkPos,ChunkMemA,i,PlayFrame              :long;
  40. var PlaySound                                   :array [1..2] of boolean;
  41. var StartSec,EndSec,StartMSec,EndMSec           :long;
  42. var FHandle                                     :BPTR;
  43. var PathFR                                      :string[250];
  44. var FileName                                    :string[100];
  45. var ColorUsed,j,ColCnt,YOffset                  :integer;
  46. var AScr                                        :byte;
  47. var Tags                                        :TagArr;
  48. var NeuScreen                                   :NewScreen;
  49. var MyScreen                                    :array [1..2] of ^Screen;
  50. var SoundMemA,SoundMemL                         :array [1..2] of long;
  51. var LineSize,BodyAddr                           :long;
  52. var SoundModeOffset,SoundModeLength,LoopNum     :word;
  53. var LData                                       :^byte;
  54. var s                                           :string;
  55.  
  56. var ErrorFlag,HeadFlag,FirstFrame,JumpAllowed   :Boolean;
  57. var DeltaMemA,DeltaMemL,ScrMode,
  58.     InEffectiveFrames                           :long;
  59.  
  60.  
  61.  
  62. procedure INITVARS;
  63.  
  64. begin
  65.    LData:=ptr($BFE001); LData^:=LData^ or 2;
  66.    IBase:=IntBase;
  67.    Frames:=0;        InEffectiveFrames:=0;
  68.    ErrorFlag:=false; HeadFlag:=false;
  69.    FirstFrame:=true;
  70.    DeltaMemA:=0;     SpaceMem:=0;     AScr:=1;
  71.    CMAPPos:=0;       Scrmode:=0;      YOffset:=0;
  72.    for i:=1 to 2 do begin
  73.       MyScreen[i]:=NIL;
  74.       SoundMemA[i]:=0;
  75.       SoundMemL[i]:=0;
  76.    end;
  77.    FirstSEntry:=SndListEntry(NIL,0,0,0);
  78.    FirstDEntry:=PicListEntry(NIL,0,0,0,0,0,0,0);
  79. end;
  80.  
  81.  
  82.  
  83. procedure GAMEEXIT;
  84.  
  85. begin
  86.    if MyScreen[AScr]<>NIL then CloseScreen(MyScreen[AScr]);
  87.    if MyScreen[3-AScr]<>NIL then CloseScreen(MyScreen[3-AScr]);
  88.    for i:=1 to 2 do MyScreen[i]:=NIL;
  89.    for i:=1 to 2 do if SoundMemA[i]<>0 then begin
  90.       FreeMem(SoundMemA[i],SoundMemL[i]);
  91.       SoundMemA[i]:=0; SoundMemL[i]:=0;
  92.    end;
  93.    if SpaceMem<>0 then FreeMem(SpaceMem,8); SpaceMem:=0;
  94. end;
  95.  
  96.  
  97.  
  98. function GETSCREENMODE(ScrMode :long):long;
  99.  
  100. var MySReq                      :^rtScreenModeRequester;
  101. var Opened                      :boolean;
  102. var TimeOutSec,TimeOutMSec      :long;
  103.  
  104. begin
  105.    TimeOutSec:=IBase^.Seconds;
  106.    TimeOutMSec:=IBase^.Micros;
  107.    GETSCREENMODE:=0;
  108.    if RTBase=NIL then begin
  109.       RTBase:=OpenLibrary('reqtools.library',0);
  110.       Opened:=true;
  111.    end else Opened:=false;
  112.    if RTBase<>NIL then begin
  113.       MySReq:=rtAllocRequestA(RT_SCREENMODEREQ,NIL);
  114.       if MySReq<>NIL then begin
  115.          if ScrMode and $80000=0 then ScrMode:=ScrMode or $80000
  116.           else ScrMode:=ScrMode and not $80000;
  117.          Tags:=TagArr(RTSC_DisplayID,ScrMode,0,0,0,0,0,0,0,0);
  118.          l:=rtChangeReqAttrA(MySReq,^Tags);
  119.          Tags:=TagArr(0,0,0,0,0,0,0,0,0,0);
  120.          if rtScreenModeRequestA(MySReq,'Select a new screenmode!',^Tags) then begin
  121.             if ScrMode and $800=$800 then MySReq^.DisplayID:=MySReq^.DisplayID and $800;
  122.             GETSCREENMODE:=MySReq^.DisplayID;
  123.          end;
  124.          rtFreeRequest(MySReq);
  125.       end;
  126.       if Opened then Closelib(RTBase);
  127.    end;
  128.    StartSec:=StartSec+(IBase^.Seconds-TimeOutSec);
  129.    StartMSec:=StartMSec+(IBase^.Micros-TimeOutMSec);
  130. end;
  131.  
  132.  
  133.  
  134. procedure WRITEX(s :string);
  135.  
  136. begin
  137.    if FromWB then writeln(f,s) else writeln(s);
  138. end;
  139.  
  140.  
  141.  
  142. procedure WRITEXX(s1,s2,s3 :string);
  143.  
  144. begin
  145.    if FromWB then writeln(f,s1,s2,s3) else writeln(s1,s2,s3);
  146. end;
  147.  
  148.  
  149.  
  150. procedure READCDXL;
  151.  
  152. type XLHeader=record
  153.         CDXLType,Info                   :byte;
  154.         CurrSize,PrevSize               :long;
  155.         res1                            :word;
  156.         CurrFrameNum,Width,Height,Depth :word;
  157.         CMapSize,RawSoundSize           :word;
  158.         res2,res3                       :long;
  159.      end;
  160.  
  161. type PArr8=array [0..7] of PLANEPTR;
  162.  
  163. var ScrMode,ColCnt,Frames,LoadValue     :long;
  164. var XLHD                                :XLHeader;
  165. var BitMapSize,IMemA,CMemA,PlaneSize    :long;
  166. var SMemA                               :array [1..2] of long;
  167. var MyBitMap                            :BitMap;
  168. var MyPArr8                             :PArr8;
  169. var PlayRate                            :word;
  170.  
  171.  
  172. procedure CDXLEXIT;
  173.  
  174. begin
  175.    if IMemA<>0 then FreeMem(IMemA,BitMapSize);
  176.    if CMemA<>0 then FreeMem(CMemA,XLHD.CMapSize);
  177.    for i:=1 to 2 do if SMemA[i]<>0 then FreeMem(SMemA[i],XLHD.RawSoundSize);
  178. end;
  179.  
  180.  
  181. begin
  182.    IMemA:=0; CMemA:=0; Frames:=0;
  183.    for i:=1 to 2 do SMemA[i]:=0;
  184.    l:=DosSeek(FHandle,0,OFFSET_BEGINNING);
  185.    DMACON_WRITE^:=$000F;
  186.    StartSec:=IBase^.Seconds;
  187.    StartMSec:=IBase^.Micros;
  188.    repeat
  189.       Frames:=Frames+1;
  190.       l:=DosRead(FHandle,^XLHD,sizeof(XLHeader));
  191.       if Frames=1 then with XLHD do PlayRate:=round((1090*325)/RawSoundSize);
  192.       if l=0 then begin
  193.          repeat until NTREQ_READ^ and $0180<>0;
  194.          WRITEXX('   Frames: ',intstr(Frames),'');
  195.          WRITEX('           CDXL');
  196.          l:=round((IBase^.Seconds-StartSec)*100+(IBase^.Micros-StartMSec)/10000);
  197.          WRITEXX('          ',realstr(l/100,2),' sec');
  198.          CDXLEXIT;
  199.          exit;
  200.       end;
  201.       if not XLHD.CDXLType=1 then begin
  202.          WRITEX('No IFF- or CDXL-Format!');
  203.          CDXLEXIT;
  204.          exit;
  205.       end;
  206.       if not (XLHD.Info and $0F in [$00,$01])
  207.       or not (XLHD.Info and $F0 in [$00,$10]) then begin
  208.          WRITEX('Unsupported CDXL-Format!');
  209.          CDXLEXIT;
  210.          exit;
  211.       end;
  212.       XLHD.CurrSize:=XLHD.CurrSize-sizeof(XLHeader);
  213.       if MyScreen[1]=NIL then with XLHD do if CurrSize>0 then begin
  214.          s:='   Screen: '+intstr(Width)+' x '+intstr(Height)+' x '+intstr(Depth);
  215.          WRITEX(s);
  216.          WRITEX('   Sound:  8 Bit');
  217.          WRITEX('           11025 Hz');
  218.          if Info and $10=$10 then WRITEX('           STEREO') else WRITEX('           MONO (Pseudo-STEREO)');
  219.  
  220.          BitMapSize:=(Width*Height) div 8*Depth;
  221.          CMemA:=AllocMem(CMapSize,0);
  222.          if CMemA=0 then exit;
  223.          IMemA:=AllocMem(BitMapSize,MEMF_CHIP);
  224.          if IMemA=0 then begin
  225.             WRITEX('Not enough memory!');
  226.             CDXLEXIT;
  227.             exit;
  228.          end;
  229.          case Depth of
  230.             1: ColCnt:=2;
  231.             2: ColCnt:=4;
  232.             3: ColCnt:=8;
  233.             4: ColCnt:=16;
  234.             5: ColCnt:=32;
  235.             6: ColCnt:=64;
  236.             7: ColCnt:=128;
  237.             8: ColCnt:=256;
  238.          end;
  239.          for i:=1 to 2 do begin
  240.             SMemA[i]:=AllocMem(RawSoundSize,MEMF_CHIP);
  241.             if SMemA[i]=0 then begin
  242.                CDXLEXIT;
  243.                exit;
  244.             end;
  245.          end;
  246.          if Info and $10=$10 then begin
  247.             SoundModeLength:=RawSoundSize div 4;
  248.             SoundModeOffset:=RawSoundSize div 2;
  249.          end else begin
  250.             SoundModeLength:=RawSoundSize div 2;
  251.             SoundModeOffset:=0;
  252.          end;
  253.  
  254.          SPVolA^:=64;                 SPVolB^:=64;
  255.          SPFreqA^:=PlayRate;
  256.          if Info and $10=$10 then SPFreqB^:=PlayRate else SPFreqB^:=pred(PlayRate);
  257.  
  258.          ScrMode:=$A1000;
  259.          for j:=1 to 2 do if MyScreen[1]=NIL then begin
  260.             if Info and $1=$1 then ScrMode:=ScrMode or $800;
  261.             Tags:=TagArr(SA_DisplayID,   ScrMode,
  262.                          SA_INTERLEAVED, _FALSE,
  263.                          SA_DRAGGABLE,   _FALSE,
  264.                          0,0,0,0);
  265.             NeuScreen:=NewScreen(160-Width div 2,0,XLHD.Width,XLHD.Height,XLHD.Depth,0,0,0,
  266.                                  CUSTOMSCREEN+SCREENQUIET,NIL,'BigAnimFX',NIL,NIL);
  267.             for i:=1 to 2 do begin
  268.                MyScreen[i]:=OpenScreenTagList(^NeuScreen,^Tags);
  269.                if (MyScreen[i]=NIL) and (j>1) then begin
  270.                   if i=2 then CloseScreen(MyScreen[1]);
  271.                   MyScreen[1]:=NIL;
  272.                   WRITEX('Couldn´t open screen!');
  273.                   exit;
  274.                end;
  275.             end;
  276.             ScrMode:=$21000;
  277.          end;
  278.          AScr:=1;
  279.          PlaneSize:=Width*Height div 8;
  280.          for i:=1 to Depth do MyPArr8[pred(i)]:=ptr(IMemA+PlaneSize*pred(i));
  281.          if Depth<8 then for i:=succ(Depth) to 8 do MyPArr8[pred(i)]:=NIL;
  282.          MyBitMap:=BitMap(Width div 8,Height,0,Depth,0,MyPArr8);
  283.       end;
  284.       if XLHD.CurrSize>0 then begin
  285.          XLHD.CurrSize:=XLHD.CurrSize-DosRead(FHandle,ptr(CMemA),XLHD.CMapSize);
  286.          LoadRGB4(^MyScreen[Ascr]^.ViewPort,ptr(CMema),ColCnt);
  287.  
  288.          l:=DosSeek(FHandle,XLHD.CurrSize-XLHD.RawSoundSize-BitMapSize,OFFSET_CURRENT);
  289.  
  290.          l:=DosRead(FHandle,ptr(IMemA),BitMapSize);
  291.          BltBitMapRastPort(^MyBitMap,0,0,^MyScreen[Ascr]^.RastPort,0,0,XLHD.Width,XLHD.Height,192);
  292.  
  293.          l:=DosRead(FHandle,ptr(SMemA[AScr]),XLHD.RawSoundSize);
  294.  
  295.          SPAddrA^:=SMemA[AScr];       SPAddrB^:=SMemA[AScr]+SoundModeOffset;
  296.          SPLengthA^:=SoundModeLength; SPLengthB^:=SoundModeLength;
  297.          DMACON_WRITE^:=$8003; NTREQ_WRITE^:=$0180;
  298.          ScreenToFront(MyScreen[AScr]); AScr:=3-AScr;
  299.          if Frames>1 then repeat until NTREQ_READ^ and $0180<>0;
  300.       end;
  301.     until XLHD.CurrSize<=0;
  302. end;
  303.  
  304.  
  305.  
  306. procedure READIFF;
  307.  
  308. type DPaintAnimHeader=record
  309.         Version,Frames          :word;
  310.         FPS,pad1,pad2,pad3      :byte;
  311.      end;
  312.  
  313. Type BitMapHeader=Record
  314.         Width,Height    :Word;
  315.         dX,dY           :Integer;
  316.         Depth,Mask      :Byte;
  317.         Kompr,pad       :Boolean;
  318.         transcolor      :Word;
  319.         XAspect,YAspect :Byte;
  320.         SWidth,SHeight  :integer
  321.      End;
  322.  
  323. type AnimHeader=record
  324.         Operation,Mask          :byte;
  325.         Width,Height            :word;
  326.         x,y                     :integer;
  327.         AbsTime,RelTime         :long;
  328.         Interleave              :byte;
  329.         pad0                    :byte;
  330.         Bits                    :long;
  331.         pad                     :array [1..16] of byte;
  332.      end;
  333.  
  334. type SXHeader=record;
  335.         SampleDepth,FixedVolume                 :byte;
  336.         Length,PlayRate,CompressionMethod       :long;
  337.         UsedChannels,UsedMode                   :byte;
  338.         PlayFreq                                :long;
  339.         Loop                                    :word;
  340.      end;
  341.  
  342. const MD_MONO=1;
  343. const MD_STEREO=2;
  344. const CH_LEFT=1;
  345. const CH_RIGHT=2;
  346. const CH_CENTER=4;
  347.  
  348. const MODE_LOADDATA=1;
  349. const MODE_PLAYALONE=2;
  350. const MODE_PLAYLOAD=3;
  351.  
  352. type DeLTA=record;
  353.         DataPtr         :array[1..16] of long;
  354.      end;
  355.  
  356. var DPAN                                :DPaintAnimHeader;
  357. var BMHD                                :BitMapHeader;
  358. var ANHD                                :AnimHeader;
  359. var DLTA                                :DeLTA;
  360. var SXHD                                :SXHeader;
  361. var LoadValue,MaxLoad,LastFORMPos,
  362.     RestFORMSize,PlayFrames,stFrameTime,
  363.     LoopPos                             :long;
  364. var i,j,Zeile,Plane,Count               :integer;
  365. var PlayMode,MyAnimType                 :byte;
  366. var SndPlay                             :boolean;
  367.  
  368.  
  369.  
  370. function OPENMYSCREENS(ScrMode :long):boolean;
  371.  
  372. var XOffset     :integer;
  373.  
  374. begin
  375.    if MyScreen[1]<>NIL then exit;
  376.    OPENMYSCREENS:=false;
  377.    if ScrMode and $F0000=0 then begin
  378.       if BMHD.Width<=320 then ScrMode:=Scrmode and not $8000;
  379.       if BMHD.Height<=256 then ScrMode:=Scrmode and not $4;
  380.       ScrMode:=ScrMode or $21000;
  381.    end;
  382.    if ScrMode and $8000=0 then XOffset:=160-(BMHD.Width div 2)
  383.    else XOffset:=320-(BMHD.Width div 2);
  384.    if ScrMode and $10000=$10000 then begin {*** NTSC ***}
  385.       if ScrMode and $4=0 then YOffset:=100-(BMHD.Height div 2)
  386.       else YOffset:=200-(BMHD.Height div 2)
  387.    end else if ScrMode and $20000=$20000 then begin {*** PAL ***}
  388.       if ScrMode and $4=0 then YOffset:=128-(BMHD.Height div 2)
  389.       else YOffset:=256-(BMHD.Height div 2);
  390.    end else YOffset:=0;
  391.    Tags:=TagArr(SA_DisplayID,   ScrMode,
  392.                 SA_INTERLEAVED, _FALSE,
  393.                 SA_DRAGGABLE,   _FALSE,
  394.                 OSCAN_VIDEO,_TRUE,0,0);
  395.    if (XOffset>=0) and (YOffset>=0) then begin
  396.       Tags[7]:=0; Tags[8]:=0;
  397.    end else WRITEX('           Overscan');
  398.    for i:=1 to 2 do begin
  399.       if YOffset<0 then NeuScreen:=NewScreen(XOffset,YOffset,BMHD.Width,BMHD.Height,BMHD.Depth,0,0,0,CUSTOMSCREEN+SCREENQUIET,NIL,'BigAnimFX',NIL,NIL)
  400.       else NeuScreen:=NewScreen(XOffset,0,BMHD.Width,BMHD.Height+YOffset,BMHD.Depth,0,0,0,CUSTOMSCREEN+SCREENQUIET,NIL,'BigAnimFX',NIL,NIL);
  401.       MyScreen[i]:=OpenScreenTagList(^NeuScreen,^Tags);
  402.       if MyScreen[i]=NIL then begin
  403.          if i=2 then CloseScreen(MyScreen[1]);
  404.          MyScreen[1]:=NIL;
  405.          exit;
  406.       end;
  407.    end;
  408.    AScr:=1;
  409.    if YOffset<0 then YOffset:=0;
  410.    OPENMYSCREENS:=true;
  411. end;
  412.  
  413.  
  414.  
  415. procedure CREATECOLORMAP(TAddr,SAddr :long);
  416.  
  417. var DataB       :^byte;
  418. var DataW       :^word;
  419. var DataL       :^long;
  420. var i,j,Colors  :word;
  421.  
  422. begin
  423.    DataW:=ptr(TAddr);    TAddr:=TAddr+2;
  424.    Colors:=ChunkLength div 3;
  425.    if Colors>ColCnt then Colors:=ColCnt;
  426.    DataW^:=Colors;
  427.    DataW:=ptr(TAddr); TAddr:=TAddr+2; DataW^:=0;
  428.    for i:=1 to Colors do for j:=1 to 3 do begin
  429.       DataL:=ptr(TAddr); TAddr:=TAddr+4;
  430.       DataB:=ptr(SAddr); SAddr:=SAddr+1;
  431.       DataL^:=$1000000*DataB^;
  432.    end;
  433.    DataL:=Ptr(TAddr); DataL^:=0;
  434. end;
  435.  
  436.  
  437.  
  438. procedure READCHUNK;
  439.  
  440. begin
  441.    l:=DosRead(FHandle,^ChunkName,4);
  442.    ChunkName[5]:=chr(0);
  443.    l:=l+DosRead(FHandle,^ChunkLength,4);
  444.    if l<8 then ErrorFlag:=true;
  445. end;
  446.  
  447.  
  448.  
  449.  
  450. Procedure FileError;
  451.  
  452. Begin
  453.    WRITEX('File Error!');
  454.    ErrorFlag:=true;
  455. End;
  456.  
  457.  
  458.  
  459. procedure ANIM8_32;
  460.  
  461.  
  462. var i,j                         :long;
  463. var Addr,PlaneAddr,ColumnCtr,
  464.     ColumnTarget                :long;
  465. var OpCode,Data1,Data2          :^long;
  466. var OpCtr                       :long;
  467. var NewVert                     :boolean;
  468.  
  469. begin
  470.    DataAddr:=ptr(DeltaMemA);
  471.    ColumnTarget:=BMHD.Width div 8;
  472.    for i:=1 to 16 do if DataAddr^[i]<>0 then begin
  473.       if i>BMHD.Depth then exit;
  474.       Addr:=DataAddr^[i]+DeltaMemA;
  475.       ColumnCtr:=-4;
  476.       OpCtr:=0;
  477.       PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
  478.                       +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  479.       while ColumnCtr<ColumnTarget do begin
  480.  
  481.          OpCode:=ptr(Addr); Addr:=Addr+4;
  482.          if OpCtr=0 then NewVert:=true;
  483.  
  484.          if NewVert then begin
  485.             ColumnCtr:=ColumnCtr+4;
  486.             PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
  487.                        +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  488.             OpCtr:=OpCode^;
  489.             if OpCtr<>0 then begin
  490.                OpCtr:=OpCode^;
  491.                NewVert:=false;
  492.                OpCode:=ptr(Addr); Addr:=Addr+4;
  493.             end;
  494.          end;
  495.  
  496.          if (ColumnCtr<ColumnTarget) and not NewVert then begin
  497.             if OpCode^=0 then begin
  498.                OpCode:=ptr(Addr); Addr:=Addr+4;
  499.                Data1:=ptr(Addr);  Addr:=Addr+4;
  500.                for j:=1 to OpCode^ do begin
  501.                   Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  502.                   Data2^:=Data1^;
  503.                end;
  504.                OpCtr:=OpCtr-1;
  505.             end else if (OpCode^ and $80000000=0) then begin
  506.                PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
  507.                OpCtr:=OpCtr-1;
  508.             end else if (OpCode^ and $80000000=$80000000) then begin
  509.                for j:=1 to (OpCode^ and $7FFFFFFF) do begin
  510.                   Data1:=ptr(Addr);      Addr:=Addr+4;
  511.                   Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  512.                   Data2^:=Data1^;
  513.                end;
  514.                OpCtr:=OpCtr-1;
  515.             end;
  516.          end;
  517.       end;
  518.    end;
  519. end;
  520.  
  521.  
  522.  
  523. procedure ANIM8_16;
  524.  
  525.  
  526. var i,j                         :integer;
  527. var Addr,PlaneAddr,ColumnCtr,
  528.     ColumnTarget                :long;
  529. var OpCode,Data1,Data2          :^word;
  530. var OpCtr                       :word;
  531. var NewVert                     :boolean;
  532.  
  533. begin
  534.    DataAddr:=ptr(DeltaMemA);
  535.    ColumnTarget:=BMHD.Width div 8;
  536.    for i:=1 to 16 do if DataAddr^[i]<>0 then begin
  537.       if i>BMHD.Depth then exit;
  538.       Addr:=DataAddr^[i]+DeltaMemA;
  539.       ColumnCtr:=-2;
  540.       OpCtr:=0;
  541.       PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
  542.                  +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  543.       while ColumnCtr<ColumnTarget do begin
  544.  
  545.          OpCode:=ptr(Addr); Addr:=Addr+2;
  546.          if OpCtr=0 then NewVert:=true;
  547.  
  548.          if NewVert then begin
  549.             ColumnCtr:=ColumnCtr+2;
  550.             PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
  551.                        +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  552.             OpCtr:=OpCode^;
  553.             if OpCtr<>0 then begin
  554.                OpCtr:=OpCode^;
  555.                NewVert:=false;
  556.                OpCode:=ptr(Addr); Addr:=Addr+2;
  557.             end;
  558.          end;
  559.  
  560.          if (ColumnCtr<ColumnTarget) and not NewVert then begin
  561.             if OpCode^=0 then begin
  562.                OpCode:=ptr(Addr); Addr:=Addr+2;
  563.                Data1:=ptr(Addr);  Addr:=Addr+2;
  564.                for j:=1 to OpCode^ do begin
  565.                   Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  566.                   Data2^:=Data1^;
  567.                end;
  568.                OpCtr:=OpCtr-1;
  569.             end else if (OpCode^ and $8000=0) then begin
  570.                PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
  571.                OpCtr:=OpCtr-1;
  572.             end else if (OpCode^ and $8000=$8000) then begin
  573.                for j:=1 to (OpCode^ and $7FFF) do begin
  574.                   Data1:=ptr(Addr);      Addr:=Addr+2;
  575.                   Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  576.                   Data2^:=Data1^;
  577.                end;
  578.                OpCtr:=OpCtr-1;
  579.             end;
  580.          end;
  581.       end;
  582.    end;
  583. end;
  584.  
  585.  
  586.  
  587. procedure ANIM7_32;
  588.  
  589.  
  590. var i,j                         :integer;
  591. var OpAddr,DAddr,PlaneAddr,
  592.     ColumnCtr,ColumnTarget      :long;
  593. var DataL1,DataL2               :^long;
  594. var OpCode                      :^byte;
  595. var OpCtr                       :byte;
  596. var NewVert                     :boolean;
  597.  
  598. begin
  599.    DataAddr:=ptr(DeltaMemA);
  600.    ColumnTarget:=BMHD.Width div 8;
  601.    for i:=1 to 8 do if DataAddr^[i]<>0 then begin
  602.       if i>BMHD.Depth then exit;
  603.       OpAddr:=DataAddr^[i]+DeltaMemA;
  604.       DAddr:=DataAddr^[i+8]+DeltaMemA;
  605.       ColumnCtr:=-4;
  606.       OpCtr:=0;
  607.       PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
  608.                  +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  609.       while ColumnCtr<ColumnTarget do begin
  610.  
  611.          OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
  612.          if OpCtr=0 then NewVert:=true;
  613.  
  614.          if NewVert then begin
  615.             ColumnCtr:=ColumnCtr+4;
  616.             PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
  617.                        +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  618.             OpCtr:=OpCode^;
  619.             if OpCtr<>0 then begin
  620.                OpCtr:=OpCode^;
  621.                NewVert:=false;
  622.                OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
  623.             end;
  624.          end;
  625.  
  626.          if (ColumnCtr<ColumnTarget) and not NewVert then begin
  627.             if OpCode^=0 then begin
  628.                OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
  629.                DataL1:=ptr(DAddr);  DAddr:=DAddr+4;
  630.                for j:=1 to OpCode^ do begin
  631.                   DataL2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  632.                   DataL2^:=DataL1^;
  633.                end;
  634.                OpCtr:=OpCtr-1;
  635.             end else if (OpCode^ and $80=0) then begin
  636.                PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
  637.                OpCtr:=OpCtr-1;
  638.             end else if (OpCode^ and $80=$80) then begin
  639.                for j:=1 to (OpCode^ and $7F) do begin
  640.                   DataL1:=ptr(DAddr);     DAddr:=DAddr+4;
  641.                   DataL2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  642.                   DataL2^:=DataL1^;
  643.                end;
  644.                OpCtr:=OpCtr-1;
  645.             end;
  646.          end;
  647.       end;
  648.    end;
  649. end;
  650.  
  651.  
  652.  
  653. procedure ANIM7_16;
  654.  
  655.  
  656. var i,j                         :integer;
  657. var OpAddr,DAddr,PlaneAddr,
  658.     ColumnCtr,ColumnTarget      :long;
  659. var DataW1,DataW2               :^word;
  660. var OpCode                      :^byte;
  661. var OpCtr                       :byte;
  662. var NewVert                     :boolean;
  663.  
  664. begin
  665.    DataAddr:=ptr(DeltaMemA);
  666.    ColumnTarget:=BMHD.Width div 8;
  667.    for i:=1 to 8 do if DataAddr^[i]<>0 then begin
  668.       if i>BMHD.Depth then exit;
  669.       OpAddr:=DataAddr^[i]+DeltaMemA;
  670.       DAddr:=DataAddr^[i+8]+DeltaMemA;
  671.       ColumnCtr:=-2;
  672.       OpCtr:=0;
  673.       PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
  674.                  +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  675.       while ColumnCtr<ColumnTarget do begin
  676.  
  677.          OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
  678.          if OpCtr=0 then NewVert:=true;
  679.  
  680.          if NewVert then begin
  681.             ColumnCtr:=ColumnCtr+2;
  682.             PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
  683.                        +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  684.             OpCtr:=OpCode^;
  685.             if OpCtr<>0 then begin
  686.                OpCtr:=OpCode^;
  687.                NewVert:=false;
  688.                OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
  689.             end;
  690.          end;
  691.  
  692.          if (ColumnCtr<ColumnTarget) and not NewVert then begin
  693.             if OpCode^=0 then begin
  694.                OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
  695.                DataW1:=ptr(DAddr);  DAddr:=DAddr+2;
  696.                for j:=1 to OpCode^ do begin
  697.                   DataW2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  698.                   DataW2^:=DataW1^;
  699.                end;
  700.                OpCtr:=OpCtr-1;
  701.             end else if (OpCode^ and $80=0) then begin
  702.                PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
  703.                OpCtr:=OpCtr-1;
  704.             end else if (OpCode^ and $80=$80) then begin
  705.                for j:=1 to (OpCode^ and $7F) do begin
  706.                   DataW1:=ptr(DAddr);     DAddr:=DAddr+2;
  707.                   DataW2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  708.                   DataW2^:=DataW1^;
  709.                end;
  710.                OpCtr:=OpCtr-1;
  711.             end;
  712.          end;
  713.       end;
  714.    end;
  715. end;
  716.  
  717.  
  718.  
  719. procedure ANIM5;
  720.  
  721.  
  722. var i,j                         :byte;
  723. var Addr,PlaneAddr,ColumnCtr,
  724.     ColumnTarget,EndAddr        :long;
  725. var OpCode,Data1,Data2          :^byte;
  726. var OpCtr                       :byte;
  727. var NewVert                     :boolean;
  728.  
  729. begin
  730.    DataAddr:=ptr(DeltaMemA);
  731.    ColumnTarget:=BMHD.Width div 8;
  732.    for i:=1 to 16 do if DataAddr^[i]<>0 then begin
  733.       if i>BMHD.Depth then exit;
  734.       with MyScreen[AScr]^.RastPort.BitMap^ do EndAddr:=long(Planes[pred(i)])+(BytesPerRow*Rows);
  735.       Addr:=DataAddr^[i]+DeltaMemA;
  736.       ColumnCtr:=-1;
  737.       OpCtr:=0;
  738.       PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
  739.                  +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  740.       while ColumnCtr<ColumnTarget do begin
  741.          OpCode:=ptr(Addr); Addr:=Addr+1;
  742.          if OpCtr=0 then NewVert:=true;
  743.  
  744.          if NewVert then begin
  745.             ColumnCtr:=ColumnCtr+1;
  746.             PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
  747.                        +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  748.             OpCtr:=OpCode^;
  749.             if OpCtr<>0 then begin
  750.                OpCtr:=OpCode^;
  751.                NewVert:=false;
  752.                OpCode:=ptr(Addr); Addr:=Addr+1;
  753.             end;
  754.          end;
  755.  
  756.          if (ColumnCtr<ColumnTarget) and not NewVert then begin
  757.             if OpCode^=0 then begin
  758.                OpCode:=ptr(Addr); Addr:=Addr+1;
  759.                Data1:=ptr(Addr);  Addr:=Addr+1;
  760.                for j:=1 to OpCode^ do if PlaneAddr<EndAddr then begin
  761.                   Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  762.                   Data2^:=Data1^;
  763.                end;
  764.                OpCtr:=OpCtr-1;
  765.             end else if (OpCode^ and $80=0) then begin
  766.                PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
  767.                OpCtr:=OpCtr-1;
  768.             end else if (OpCode^ and $80=$80) then begin
  769.                for j:=1 to (OpCode^ and $7F) do begin
  770.                   Data1:=ptr(Addr);      Addr:=Addr+1;
  771.                   Data2:=ptr(PlaneAddr);
  772.                   if PlaneAddr<EndAddr then Data2^:=Data1^;
  773.                   PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
  774.                end;
  775.                OpCtr:=OpCtr-1;
  776.             end;
  777.          end;
  778.       end;
  779.    end;
  780. end;
  781.  
  782.  
  783.  
  784. Procedure LiesZeile(Adr:Long; Plane :byte);
  785.  
  786. Var Count,Size          :Long;
  787. var i,j                 :integer;
  788. var Head,Body,Mem       :^Short;
  789.  
  790. Begin
  791.    Adr:=Adr+(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
  792.    If Not ErrorFlag Then Begin
  793.       Size:=(BMHD.Width+7) div 8;
  794.       If not BMHD.Kompr Then begin
  795.          CopyMemQuick(BodyAddr,Adr,Size);
  796.          BodyAddr:=BodyAddr+Size;
  797.       End Else Begin
  798.          i:=0;
  799.          While (i<Size) and not ErrorFlag Do Begin
  800.             Head:=ptr(BodyAddr); BodyAddr:=BodyAddr+1;
  801.             If Head^>=0 Then Begin
  802.                CopyMem(BodyAddr,Adr+i,Head^+1);
  803.                BodyAddr:=BodyAddr+Head^+1;
  804.                i:=i+Head^+1
  805.             End Else Begin
  806.                Body:=ptr(BodyAddr); BodyAddr:=BodyAddr+1;
  807.                For j:=1 to 1-Head^ Do Begin
  808.                   Mem:=Ptr(Adr+i);
  809.                   Mem^:=Body^;
  810.                   i:=i+1
  811.                End
  812.             End
  813.          End
  814.       End;
  815.    End
  816. End;
  817.  
  818.  
  819.  
  820. procedure HANDLESPACEMEM;
  821.  
  822. begin
  823.    if MySEntry=NIL then begin
  824.       if SpaceMem<>0 then FreeMem(SpaceMem,8);
  825.       SpaceMem:=0;
  826.       PlaySound[AScr]:=false;
  827.       exit;
  828.    end;
  829.    if MySEntry^.FrameNum<>PlayFrame then begin
  830.       PlaySound[AScr]:=false;
  831.       exit;
  832.    end;
  833.    if MySEntry^.SMemL>=SoundMemL[AScr] then begin
  834.       FreeMem(SoundMemA[AScr],SoundMemL[AScr]);
  835.       SoundMemL[AScr]:=MySEntry^.SMemL;
  836.       if SpaceMem<>0 then begin
  837.          SoundMemA[AScr]:=AllocMem(SoundMemL[AScr],MEMF_CHIP);
  838.          if SoundMemA[AScr]=0 then begin
  839.             WRITEX('Not enough CHIP-memory for sampledata!');
  840.             FreeMem(SpaceMem,8); SpaceMem:=0;
  841.             PlaySound[AScr]:=false;
  842.             exit;
  843.          end;
  844.       end;
  845.    end;
  846.    if SXHD.UsedMode=MD_STEREO then begin
  847.       SoundModeLength:=MySEntry^.SMemL div 4;
  848.       SoundModeOffset:=MySEntry^.SMemL div 2;
  849.    end else begin
  850.       SoundModeLength:=MySEntry^.SMemL div 2;
  851.       SoundModeOffset:=0;
  852.    end;
  853.    PlaySound[AScr]:=true
  854. end;
  855.  
  856.  
  857.  
  858. procedure FREESENTRY(FreeSEntry :p_SndListEntry);
  859.  
  860. begin
  861.    if FreeSEntry^.SMemA<>0 then FreeMem(FreeSEntry^.SMemA,FreeSEntry^.SMemL);
  862.    FreeMem(long(FreeSEntry),sizeof(p_SndListEntry));
  863. end;
  864.  
  865.  
  866.  
  867. procedure FREEDENTRY(FreeDEntry :p_PicListEntry);
  868.  
  869. begin
  870.    if FreeDEntry^.PMemA<>0 then FreeMem(FreeDEntry^.PMemA,FreeDEntry^.PMemL);
  871.    if FreeDEntry^.CMemA<>0 then FreeMem(FreeDEntry^.CMemA,FreeDEntry^.CMemL);
  872.    FreeMem(long(FreeDEntry),sizeof(p_PicListEntry));
  873. end;
  874.  
  875.  
  876.  
  877. procedure SCANANIM;
  878.  
  879.  
  880. procedure UNDOLASTFRAME;
  881.  
  882. begin
  883.    if PlayMode=MODE_LOADDATA then begin
  884.       Frames:=Frames-1;
  885.       l:=DosSeek(FHandle,LastFormPos,OFFSET_BEGINNING);
  886.    end else begin
  887.       ChunkPos:=ChunkPos-8;
  888.       l:=DosSeek(FHandle,ChunkPos,OFFSET_BEGINNING);
  889.    end;
  890.    PlayMode:=MODE_PLAYLOAD;
  891.    PlayFrames:=0;
  892. end;
  893.  
  894.  
  895. begin
  896.    while not Errorflag and (ChunkLength>0) do begin
  897.       READCHUNK;
  898.       if (PlayMode=MODE_PLAYLOAD) and (ChunkName<>'FORM') and (MaxLoad<ChunkLength) then begin
  899.          l:=DosSeek(FHandle,-8,OFFSET_CURRENT);
  900.          exit;
  901.       end;
  902.  
  903.       MaxLoad:=MaxLoad-ChunkLength;
  904.       ChunkPos:=DosSeek(FHandle,0,OFFSET_CURRENT);
  905.       JumpAllowed:=true;
  906.       if ChunkName='FORM' then begin
  907.          LastFormPos:=ChunkPos-8;
  908.          l:=DosSeek(FHandle,4,OFFSET_CURRENT);
  909.          Frames:=Frames+1;
  910.          if Frames=3 then LoopPos:=LastFormPos;
  911.       end else if ChunkName='DLTA' then begin
  912.          if (FirstDEntry.NextPicEntry=NIL) or (LoadDEntry^.FrameNum<Frames) then begin
  913.             l:=AllocMem(sizeof(PicListEntry),MEMF_FAST);
  914.             if l=0 then begin
  915.                UNDOLASTFRAME;
  916.                exit;
  917.             end;
  918.             if FirstDEntry.NextPicEntry=NIL then FirstDEntry.NextPicEntry:=ptr(l)
  919.             else LoadDEntry^.NextPicEntry:=ptr(l);
  920.             LoadDEntry:=ptr(l);
  921.             LoadDEntry^:=PicListEntry(NIL,0,Frames,0,0,0,0,0);
  922.          end;
  923.          if LoadDEntry^.PMemA=0 then begin
  924.             DeltaMemL:=ChunkLength;
  925.             DeltaMemA:=AllocMem(DeltaMemL,MEMF_FAST);
  926.             if DeltaMemA=0 then begin
  927.                UNDOLASTFRAME;
  928.                exit;
  929.             end;
  930.             l:=DosRead(FHandle,ptr(DeltaMemA),DeltaMemL);
  931.             l:=0;
  932.             DataAddr:=ptr(DeltaMemA);
  933.             i:=0;
  934.             repeat
  935.                i:=i+1;
  936.             until (i=16) or (DataAddr^[i]<>0);
  937.             if (i=16) and (DataAddr^[i]=0) then InEffectiveFrames:=InEffectiveFrames+1;
  938.             LoadDEntry^.Flags:=ANHD.Operation;
  939.             if ANHD.Reltime>1 then LoadDEntry^.MSecs:=ANHD.Reltime*16;
  940.             if DPAN.FPS>0 then LoadDEntry^.MSecs:=round(1000/DPAN.FPS);
  941.             LoadDEntry^.PMemA:=DeltaMemA;
  942.             LoadDEntry^.PMemL:=DeltaMemL;
  943.             if ANHD.Operation in [7,8] then if (ANHD.Bits and $1=$1)
  944.              then LoadDEntry^.Flags:=LoadDEntry^.Flags or $80;
  945.          end;
  946.       end else if ChunkName='SXHD' then begin
  947.          l:=DosRead(Fhandle,^SXHD,SizeOf(SXHeader));
  948.          if (SXHD.UsedChannels>CH_CENTER) or (SXHD.UsedMode>MD_STEREO) then
  949.           WRITEX('BigAnimFX supports only Mono and Stereo!')
  950.          else if SXHD.SampleDepth>8 then
  951.           WRITEX('BigAnimFX supports only 8 Bit samples!')
  952.          else if SXHD.CompressionMethod<>0 then
  953.           WRITEX('BigAnimFX doesn´t supports compressed samples!')
  954.          else begin
  955.             LoopNum:=SXHD.Loop+1;
  956.             SpaceMem:=AllocMem(8,MEMF_CHIP+MEMF_CLEAR);
  957.             WRITEXX('   Sound:  ',intstr(SXHD.SampleDepth),' Bit');
  958.             WRITEXX('           ',intstr(SXHD.PlayFreq),' Hz');
  959.             if SXHD.UsedMode=MD_STEREO then WRITEX('           STEREO (Dolby Surround®)')
  960.             else WRITEX('           MONO');
  961.          end;
  962.       end else if ChunkName='SBDY' then begin
  963.          if not FirstFrame or  (FirstSEntry.NextSndEntry=NIL) then begin
  964.             l:=AllocMem(sizeof(SndListEntry),MEMF_FAST);
  965.             if l=0 then begin
  966.                UNDOLASTFRAME;
  967.                exit;
  968.             end;
  969.             if FirstSEntry.NextSndEntry=NIL then FirstSEntry.NextSndEntry:=ptr(l)
  970.             else LoadSEntry^.NextSndEntry:=ptr(l);
  971.             LoadSEntry:=ptr(l);
  972.             LoadSEntry^:=SndListEntry(NIL,Frames,0,0);
  973.             LoadSEntry^.SMemL:=ChunkLength;
  974.             LoadSEntry^.SMemA:=AllocMem(LoadSEntry^.SMemL,MEMF_FAST);
  975.             if LoadSEntry^.SMemA=0 then begin
  976.                UNDOLASTFRAME;
  977.                exit;
  978.             end;
  979.             l:=DosRead(Fhandle,ptr(LoadSEntry^.SMemA),ChunkLength);
  980.          end;
  981.       end else if ChunkName='ANHD' then begin
  982.          l:=DosRead(Fhandle,^ANHD,SizeOf(AnimHeader));
  983.          if Frames=1 then begin
  984.             stFrameTime:=0;
  985.             if ANHD.Reltime>1 then stFrameTime:=ANHD.Reltime*16;
  986.             if DPAN.FPS>0 then stFrameTime:=round(1000/DPAN.FPS);
  987.          end;
  988.       end else if ChunkName='DPAN' then
  989.          l:=DosRead(Fhandle,^DPAN,SizeOf(DPaintAnimHeader))
  990.       else if ChunkName='BMHD' then begin
  991.          l:=DosRead(Fhandle,^BMHD,SizeOf(BitMapHeader));
  992.          If not FromWB Then With BMHD Do Begin
  993.             SWidth:=Width;
  994.             SHeight:=Height;
  995.          End;
  996.          With BMHD Do Begin
  997.             s:='   Screen: '+intstr(BMHD.Width)+' x '+intstr(BMHD.Height)+' x '
  998.                +intstr(BMHD.Depth);
  999.             WRITEX(s);
  1000.             case Depth of
  1001.                1: ColCnt:=2;
  1002.                2: ColCnt:=4;
  1003.                3: ColCnt:=8;
  1004.                4: ColCnt:=16;
  1005.                5: ColCnt:=32;
  1006.                6: ColCnt:=64;
  1007.                7: ColCnt:=128;
  1008.                8: ColCnt:=256;
  1009.             end;
  1010.          End;
  1011.          HeadFlag:=true
  1012.       end else if ChunkName='CMAP' then begin
  1013.          if (MyScreen[1]=NIL) and (ScrMode<>0) then begin
  1014.             if not OPENMYSCREENS(ScrMode) then begin
  1015.                ScrMode:=GETSCREENMODE(ScrMode);
  1016.                if not OPENMYSCREENS(ScrMode) then begin
  1017.                   WRITEX('Couldn´t open screen!');
  1018.                   exit;
  1019.                end;
  1020.             end;
  1021.             If not Headflag Then FileError;
  1022.          end else if MyScreen[1]=NIL then if ScrMode=0 then CMAPPos:=ChunkPos-8;
  1023.          if MyScreen[1]<>NIL then begin
  1024.             DeltaMemL:=ChunkLength*4+4;
  1025.             DeltaMemA:=AllocMem(DeltaMemL,MEMF_FAST);
  1026.             if DeltaMemA=0 then begin
  1027.                UNDOLASTFRAME;
  1028.                exit;
  1029.             end;
  1030.             ChunkMemA:=AllocMem(ChunkLength,MEMF_FAST);
  1031.             if ChunkMemA=0 then begin
  1032.                UNDOLASTFRAME;
  1033.                exit;
  1034.             end;
  1035.             l:=DosRead(FHandle,ptr(ChunkMemA),ChunkLength);
  1036.             CREATECOLORMAP(DeltaMemA,ChunkMemA);
  1037.             if Frames>1 then begin
  1038.                if (FirstDEntry.NextPicEntry=NIL) or (LoadDEntry^.FrameNum<Frames) then begin
  1039.                   l:=AllocMem(sizeof(PicListEntry),MEMF_FAST);
  1040.                   if l=0 then begin
  1041.                      UNDOLASTFRAME;
  1042.                      exit;
  1043.                   end;
  1044.                   if FirstDEntry.NextPicEntry=NIL then FirstDEntry.NextPicEntry:=ptr(l)
  1045.                   else LoadDEntry^.NextPicEntry:=ptr(l);
  1046.                   LoadDEntry:=ptr(l);
  1047.                   LoadDEntry^:=PicListEntry(NIL,0,Frames,0,0,0,0,0);
  1048.                end;
  1049.                if LoadDEntry^.CMemA=0 then begin
  1050.                   LoadDEntry^.CMemA:=DeltaMemA;
  1051.                   LoadDEntry^.CMemL:=DeltaMemL;
  1052.                end else FreeMem(DeltaMemA,DeltaMemL);
  1053.             end;
  1054.             if Frames=1 then begin
  1055.                LoadRGB32(^MyScreen[AScr]^.ViewPort,ptr(DeltaMemA));
  1056.                LoadRGB32(^MyScreen[3-AScr]^.ViewPort,ptr(DeltaMemA));
  1057.                FreeMem(DeltaMemA,DeltaMemL);
  1058.             end;
  1059.             FreeMem(ChunkMemA,ChunkLength);
  1060.          end;
  1061.       end else if ChunkName='CAMG' then begin
  1062.           l:=DosRead(FHandle,^ScrMode,4);
  1063.           if CMAPPos<>0 then begin
  1064.              l:=DosSeek(FHandle,CMAPPos,OFFSET_BEGINNING);
  1065.              JumpAllowed:=false; CMAPPos:=0;
  1066.           end;
  1067.       end else If ChunkName='BODY' Then Begin
  1068.          if (CMAPPos<>0) and (ScrMode=0) then begin
  1069.             Scrmode:=GENLOCK_VIDEO;
  1070.             if BMHD.Height>256 then ScrMode:=Scrmode or LACE;
  1071.             if BMHD.Width>320 then ScrMode:=ScrMode or HIRES;
  1072.             l:=DosSeek(FHandle,CMAPPos,OFFSET_BEGINNING);
  1073.             JumpAllowed:=false; CMAPPos:=0;
  1074.          end else begin
  1075.             DeltaMemA:=AllocMem(ChunkLength,0);
  1076.             if DeltaMemA=0 then begin
  1077.                DosClose(FHandle);
  1078.                WRITEX('Not enough memory!');
  1079.                exit;
  1080.             end;
  1081.             l:=DosRead(FHandle,ptr(DeltaMemA),ChunkLength);
  1082.             if l<ChunkLength then begin
  1083.                FILEERROR;
  1084.                DosClose(FHandle);
  1085.                exit;
  1086.             end;
  1087.             BodyAddr:=DeltaMemA;
  1088.             FirstFrame:=false;
  1089.             If not HeadFlag Then FileError;
  1090.             LineSize:=(MyScreen[AScr]^.Width+7) div 8;
  1091.             For Zeile:=0 to BMHD.Height-1 Do
  1092.              For Plane:=0 to pred(BMHD.Depth) Do
  1093.               LiesZeile(Long(MyScreen[Ascr]^.BitMap.Planes[Plane])+Zeile*MyScreen[AScr]^.BitMap.BytesPerRow,Plane);
  1094.             FreeMem(DeltaMemA,ChunkLength);
  1095.          end;
  1096.       End;
  1097.       if JumpAllowed and (ChunkName<>'FORM') then begin
  1098.          if odd(ChunkLength) then ChunkPos:=ChunkPos+1;
  1099.          l:=DosSeek(FHandle,ChunkPos+ChunkLength,OFFSET_BEGINNING);
  1100.       end;
  1101.    End;
  1102.    if LoopNum<=1 then PlayMode:=MODE_PLAYALONE else begin
  1103.       ErrorFlag:=false;
  1104.       PlayMode:=MODE_PLAYLOAD;
  1105.       LoopNum:=LoopNum-1;
  1106.       l:=DosSeek(FHandle,LoopPos,OFFSET_BEGINNING);
  1107.    end;
  1108. end;
  1109.  
  1110.  
  1111.  
  1112. procedure PLAYANIM;
  1113.  
  1114. begin
  1115.    MaxLoad:=0;
  1116.    while MyDEntry<>NIL do begin
  1117.       PlayFrames:=PlayFrames+1;
  1118.       PlayFrame:=PlayFrame+1;
  1119.       if SpaceMem<>0 then
  1120.        while (MySEntry^.FrameNum<MyDEntry^.FrameNum) and (MySEntry^.NextSndEntry<>NIL)
  1121.        do begin
  1122.          LastSEntry:=MySEntry;
  1123.          MySEntry:=MySEntry^.NextSndEntry;
  1124.          FREESENTRY(LastSEntry);
  1125.        end;
  1126.       HANDLESPACEMEM;
  1127.       if PlaySound[AScr] and (MySEntry^.SMemA<>0) then begin
  1128.          CopyMemQuick(MySEntry^.SMemA,SoundMemA[AScr],MySEntry^.SMemL);
  1129.          SPAddrA^:=SoundMemA[AScr];   SPAddrB^:=SoundMemA[AScr]+SoundModeOffset;
  1130.          SPLengthA^:=SoundModeLength; SPLengthB^:=SoundModeLength;
  1131.          MaxLoad:=round(((2*LoadValue)/SXHD.PlayFreq)*SoundModeLength);
  1132.          DMACON_WRITE^:=$8003;
  1133.       end else begin
  1134.          DMACON_WRITE^:=$0003;
  1135.          if MyDEntry^.MSecs=0 then MaxLoad:=MaxLoad+((LoadValue*12) div 1000)
  1136.          else MaxLoad:=MaxLoad+((LoadValue*MyDEntry^.MSecs) div 1000);
  1137.          EndMSec:=IBase^.Micros+(MyDEntry^.MSecs*1000);
  1138.          EndSec:=IBase^.Seconds;
  1139.          if EndMSec>=1000000 then begin
  1140.             l:=EndMSec div 1000000;
  1141.             EndMSec:=EndMSec-(l*1000000);
  1142.             EndSec:=EndSec+l;
  1143.          end;
  1144.       end;
  1145.       DeltaMemA:=MyDEntry^.PMemA; DeltaMemL:=MyDEntry^.PMemL;
  1146.       if LData^ and 64=0 then MyDEntry^.Flags:=255;
  1147.       case MyDEntry^.Flags of
  1148.           $5: ANIM5;
  1149.           $7: ANIM7_16;
  1150.          $87: ANIM7_32;
  1151.           $8: ANIM8_16;
  1152.          $88: ANIM8_32;
  1153.          otherwise begin
  1154.             DMACON_WRITE^:=$000F;
  1155.             if MyDEntry^.Flags<>255 then WRITEXX('Unknown ANIM-format (ANIM ',intstr(MyDEntry^.Flags and not $80),')!');
  1156.             ScreenToBack(MyScreen[AScr]);
  1157.             ScreenToBack(MyScreen[3-AScr]);
  1158.             while MyDEntry<>NIL do begin
  1159.                LastDEntry:=MyDEntry;
  1160.                MyDEntry:=MyDEntry^.NextPicEntry;
  1161.                FREEDENTRY(LastDEntry);
  1162.             end;
  1163.             if FirstSEntry.NextSndEntry<>NIL then
  1164.              while MySEntry<>NIL do begin
  1165.                LastSEntry:=MySEntry;
  1166.                MySEntry:=MySEntry^.NextSndEntry;
  1167.                FREESENTRY(LastSEntry);
  1168.             end;
  1169.             exit;
  1170.          end;
  1171.       end;
  1172.       if MyDEntry^.CMemA<>0 then begin
  1173.          LoadRGB32(^MyScreen[AScr]^.ViewPort,ptr(MyDEntry^.CMemA));
  1174.          if (MyDEntry^.NextPicEntry<>NIL) and (MyDEntry^.NextPicEntry^.CMemA=0)
  1175.           then LoadRGB32(^MyScreen[3-AScr]^.ViewPort,ptr(MyDEntry^.CMemA))
  1176.       end;
  1177.       if PlaySound[AScr] then begin
  1178.          if (PlayMode=MODE_PLAYLOAD) and (PlayFrames>3) then SCANANIM;
  1179.          repeat until NTREQ_READ^ and $0180=$180;
  1180.          NTREQ_WRITE^:=$0180;
  1181.       end else if SndPlay then begin
  1182.          repeat until NTREQ_READ^ and $0180=$180;
  1183.          DMACON_WRITE^:=$0003;
  1184.          SndPlay:=false;
  1185.       end;
  1186.       ScreenToFront(MyScreen[AScr]);
  1187.       AScr:=3-AScr;
  1188.       if SpaceMem=0 then begin
  1189.          if (PlayMode=MODE_PLAYLOAD) and (PlayFrames>3) then SCANANIM;
  1190.          repeat until (IBase^.Seconds>EndSec)
  1191.          or ((IBase^.Seconds=EndSec) and (IBase^.Micros>=EndMSec));
  1192.       end;
  1193.  
  1194.       if (PlayMode=MODE_PLAYLOAD) then if
  1195.        (MyDEntry^.NextPicEntry=NIL) or (MyDEntry^.NextPicEntry^.NextPicEntry=NIL)
  1196.        then begin
  1197.          PlayFrames:=0;
  1198.          PlayMode:=MODE_LOADDATA;
  1199.          SCANANIM;
  1200.          if LoopNum>1 then begin
  1201.             PlayMode:=MODE_LOADDATA;
  1202.             SCANANIM;
  1203.          end;
  1204.       end;
  1205.  
  1206.       LastDEntry:=MyDEntry;
  1207.       MyDEntry:=MyDEntry^.NextPicEntry;
  1208.       FREEDENTRY(LastDEntry);
  1209.       if PlaySound[AScr] and (MySEntry<>NIL) then begin
  1210.          LastSEntry:=MySEntry;
  1211.          MySEntry:=MySEntry^.NextSndEntry;
  1212.          FREESENTRY(LastSEntry);
  1213.       end;
  1214.    end;
  1215. end;
  1216.  
  1217.  
  1218.  
  1219. Begin
  1220.    INITVARS;
  1221.    Fhandle:=DosOpen(PathFR,MODE_OLDFILE);
  1222.    If FHandle=0 Then begin
  1223.       WRITEXX('Couldn´t find file »',PathFR,'« !');
  1224.       exit;
  1225.    End;
  1226.    WRITEXX('   Name:   ',PathFR,'');
  1227.    READCHUNK;
  1228.    if ChunkName<>'FORM' then begin
  1229.       READCDXL;
  1230.       DosClose(FHandle);
  1231.       exit;
  1232.    end;
  1233.    l:=DosRead(FHandle,^ChunkName,4);
  1234.    If ChunkName<>'ANIM' Then Begin
  1235.       WRITEXX('No ANIM-File (',ChunkName,')!');
  1236.       DosClose(FHandle);
  1237.       exit;
  1238.    end;
  1239.    ANHD.RelTime:=0;
  1240.    DPAN.FPS:=0;
  1241.    SoundModeLength:=0;
  1242.    PlayMode:=MODE_LOADDATA;
  1243.    StartSec:=IBase^.Seconds;
  1244.    StartMSec:=IBase^.Micros;
  1245.    MySEntry:=NIL;
  1246.    stFrameTime:=0;
  1247.    LoopNum:=1;
  1248.    SCANANIM;
  1249.    if not HeadFlag or (Frames<=1) then exit;
  1250.    EndSec:=IBase^.Seconds;
  1251.    EndMSec:=IBase^.Micros;
  1252.    l:=DosSeek(FHandle,0,OFFSET_CURRENT);
  1253.    EndSec:=round(((EndSec-StartSec)*1000)+((EndMSec-StartMSec)/1000));
  1254.    LoadValue:=round((l/EndSec)*950); {95%}
  1255.    s:=intstr(LoadValue);
  1256.    if PlayMode=MODE_PLAYLOAD then WRITEXX('   Filescan: ',s,' Bytes/sec');
  1257.    PlayFrame:=1;
  1258.    PlaySound[1]:=true;   PlaySound[2]:=true;
  1259.    MySEntry:=FirstSEntry.NextSndEntry;
  1260.    HANDLESPACEMEM;
  1261.    SndPlay:=false;
  1262.    StartSec:=IBase^.Seconds; StartMSec:=IBase^.Micros;
  1263.    if MySEntry<>NIL then begin
  1264.       SPVolA^:=SXHD.FixedVolume;    SPVolB^:=SXHD.FixedVolume;
  1265.       SPFreqA^:=SXHD.PlayRate;      SPFreqB^:=SXHD.PlayRate;
  1266.    end;
  1267.    if PlaySound[AScr] then begin
  1268.       CopyMemQuick(MySEntry^.SMemA,SoundMemA[AScr],MySEntry^.SMemL);
  1269.       SPAddrA^:=SoundMemA[AScr];    SPAddrB^:=SoundMemA[AScr]+SoundModeOffset;
  1270.       SPLengthA^:=SoundModeLength;  SPLengthB^:=SoundModeLength;
  1271.       ScreenToFront(MyScreen[AScr]);
  1272.       DMACON_WRITE^:=$8003; NTREQ_WRITE^:=$0180;
  1273.       LastSEntry:=MySEntry;
  1274.       MySEntry:=MySEntry^.NextSndEntry;
  1275.       FREESENTRY(LastSEntry);
  1276.       SndPlay:=true;
  1277.    end else begin
  1278.       EndMSec:=IBase^.Micros+(stFrameTime*1000);
  1279.       EndSec:=IBase^.Seconds;
  1280.       if EndMSec>=1000000 then begin
  1281.          l:=EndMSec div 1000000;
  1282.          EndMSec:=EndMSec-(l*1000000);
  1283.          EndSec:=EndSec+l;
  1284.       end;
  1285.       ScreenToFront(MyScreen[AScr]);
  1286.       repeat until (IBase^.Seconds>EndSec)
  1287.       or ((IBase^.Seconds=EndSec) and (IBase^.Micros>=EndMSec));
  1288.    end;
  1289.    AScr:=3-AScr;
  1290.    ClipBlit(^MyScreen[3-AScr]^.RastPort,0,YOffset,^MyScreen[Ascr]^.RastPort,0,YOffset,BMHD.Width,BMHD.Height,192);
  1291.    MyDEntry:=FirstDEntry.NextPicEntry;
  1292.    MyAnimType:=MyDEntry^.Flags;
  1293.    PLAYANIM;
  1294.  
  1295.    HANDLESPACEMEM;
  1296.    if PlaySound[AScr] and (MySEntry<>NIL) then begin
  1297.       CopyMemQuick(MySEntry^.SMemA,SoundMemA[AScr],SoundMemL[AScr]);
  1298.       SPAddrA^:=SoundMemA[AScr];   SPAddrB^:=SoundMemA[AScr]+SoundModeOffset;
  1299.       SPLengthA^:=SoundModeLength; SPLengthB^:=SoundModeLength;
  1300.       repeat until NTREQ_READ^ and $0180<>0;
  1301.       DMACON_WRITE^:=$8003;
  1302.       NTREQ_WRITE^:=$0180;
  1303.       WaitTOF;
  1304.       SPAddrA^:=SpaceMem; SPAddrB^:=SpaceMem;
  1305.       SPLengthA^:=1;      SPLengthB^:=1;
  1306.       repeat until NTREQ_READ^ and $0180=$0180;
  1307.    end else if SndPlay then repeat until NTREQ_READ^ and $0180=$180;
  1308.    DMACON_WRITE^:=$000F;
  1309.    DosClose(FHandle);
  1310.    WRITEXX('   Played: ',intstr(Frames),' Frames');
  1311.    if InEffectiveFrames>0 then WRITEXX('   Non-optimal ANIM-File! ',intstr(InEffectiveFrames),' empty frames found!');
  1312.    case MyAnimType of
  1313.        $5: WRITEX('           ANIM 5');
  1314.        $7: WRITEX('           ANIM 7, 16 Bit');
  1315.       $87: WRITEX('           ANIM 7, 32 Bit');
  1316.        $8: WRITEX('           ANIM 8, 16 Bit');
  1317.       $88: WRITEX('           ANIM 8, 32 Bit');
  1318.       otherwise;
  1319.    end;
  1320.    l:=round((IBase^.Seconds-StartSec)*100+(IBase^.Micros-StartMSec)/10000);
  1321.    WRITEXX('          ',realstr(l/100,2),' sec');
  1322. End;
  1323.  
  1324.  
  1325.  
  1326. begin
  1327.    OpenLib(intbase,'intuition.library',39);
  1328.    OpenLib(gfxbase,'graphics.library' ,39);
  1329.    OpenLib(DosBase,'dos.library',39);
  1330.    INITCHANNELS;
  1331.    DMACON_WRITE^:=$000F;
  1332.    i:=SetTaskPri(FindTask(NIL),10);
  1333.    FileName:='';
  1334.    PathFR:=parameterstr;
  1335.    PathFR[parameterlen]:=chr(0);
  1336.    if FromWB then begin
  1337.       reset(f,'CON:0/10/640/200/BigAnimFX-Output');
  1338.       if IOResult<>0 then exit
  1339.    end;
  1340.    WRITEX('');
  1341.    WRITEX('BigAnimFX V 1.57, © by QXC & VWP');
  1342.    if AvailMem(MEMF_FAST)=0 then WRITEX('No FAST-RAM found!!')
  1343.    else if PathFR='' then begin
  1344.       OpenLib(RTBase,'reqtools.library',0);
  1345.       MyFReq:=rtAllocRequestA(RT_FILEREQ,NIL);
  1346.       if MyFReq<>NIL then begin
  1347.          Tags:=TagArr(0,0,0,0,0,0,0,0,0,0);
  1348.          l:=rtChangeReqAttrA(MyFReq,^Tags);
  1349.          repeat
  1350.             PathFR:=FileName;
  1351.             l:=rtFileRequestA(MyFReq,PathFR,'Load IFF-ANIM',^Tags);
  1352.             if l<>0 then begin
  1353.                WRITEX('');
  1354.                s:=MyFReq^.Dir;
  1355.                FileName:=PathFR;
  1356.                if s<>'' then if not (s[length(s)] in ['/',':']) then
  1357.                 PathFR:=s+'/'+PathFR else PathFR:=s+PathFR;
  1358.                READIFF;
  1359.                DMACON_WRITE^:=$000F;
  1360.                GAMEEXIT;
  1361.                l:=1;
  1362.             end;
  1363.          until l=0;
  1364.          rtFreeRequest(MyFReq);
  1365.       end;
  1366.       CloseLib(RTBase);
  1367.    end else if PathFR='?' then begin
  1368.       WRITEX('   A animplayer for CDXL and IFF-ANIM 5, 7 and 8 with soundsupport');
  1369.       WRITEX('   BigAnimFX is FREEWARE and plays anims direct from disk');
  1370.       WRITEX('   Usage: BigAnimFX <filename> for CLI-handling');
  1371.       WRITEX('          BigAnimFX            for a filerequester');
  1372.       WRITEX('');
  1373.       WRITEX('   ANIMs with sound can be created using the WaveTracer®-softwarepackage,');
  1374.       WRITEX('   also developed and distributed by Virtual Worlds Productions®');
  1375.    end else begin
  1376.       READIFF;
  1377.       DMACON_WRITE^:=$000F;
  1378.       GAMEEXIT;
  1379.    end;
  1380.    WRITEX('');
  1381.    if FromWB then begin
  1382.       delay(100);
  1383.       close(f);
  1384.    end;
  1385.    CloseLib(intbase);
  1386.    CloseLib(gfxbase);
  1387.    CloseLib(DosBase);
  1388. end.
  1389.